C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  MODIFY THE NAMES OF SYMBOLS IN A SYMBOL TABLE......
C
      PROGRAM ISTCR
 
      INTEGER IODSYI, IODSYO, JUNK, IODCMD, STATUS
      INTEGER SYIPTH(81), SYOPTH(81), PROMPT(22,3),
     +        CMDPTH(81)
 
      INTEGER GETARG, OPEN, CREATE, ZGTCMD, READCF
 
      DATA (PROMPT(I,1),I=1,21)/73,110,112,117,116,32,115,
     +121,109,98,111,108,32,116,97,98,108,101,58,
     +32,129/,
     +     (PROMPT(I,2),I=1,22)/79,117,116,112,117,116,32,
     +115,121,109,98,111,108,32,116,97,98,108,101,58,
     +32,129/,
     +     (PROMPT(I,3),I=1,15)/67,111,109,109,97,110,
     +100,32,102,105,108,101,58,32,129/
 
      CALL ZINIT
 
      IF (GETARG(1,SYIPTH,81).EQ.-100) THEN
        CALL ZPRMPT(PROMPT(1,1))
        JUNK=ZGTCMD(SYIPTH,0)
      END IF
      IF (GETARG(2,SYOPTH,81).EQ.-100) THEN
        CALL ZPRMPT(PROMPT(1,2))
        JUNK=ZGTCMD(SYOPTH,0)
      END IF
      IF (GETARG(3,CMDPTH,81).EQ.-100) THEN
        CALL ZPRMPT(PROMPT(1,3))
        JUNK=ZGTCMD(CMDPTH,0)
      END IF
C
C  TRY TO OPEN/CREATE THE FILES, NOTE THAT THE INPUT TABLE IS READ
C  AND THEN CLOSED, TO ALLOW IT TO BE OVERWRITTEN IF REQUIRED.
C
      IODSYI=OPEN(SYIPTH,0)
      IF (IODSYI.EQ.-1) CALL ERROR('Can''t open input symbol table.')
      CALL ZYINSY(IODSYI)
      CALL CLOSE(IODSYI)
 
      IODSYO=CREATE(SYOPTH,1)
      IF (IODSYO.EQ.-1) CALL ERROR('Can''t create o/p symbol table.')
 
      IODCMD=OPEN(CMDPTH,0)
      IF (IODCMD.EQ.-1) CALL ERROR('Can''t open command file.')
C
C  READ THE COMMAND FILE, THEN PROCESS THE FILE AND WRITE OUT THE
C  MODIFIED SYMBOL TABLE AND QUIT.
C
      IF (READCF(IODCMD) .EQ. -1) CALL ERROR('Command File Error.')
      CALL PROFIL(IODCMD, STATUS)
      CALL ZYSOUT(IODSYO)
 
      IF(STATUS .EQ. -2) THEN
        CALL ZMESS('[ISTCR Normal Termination].',1)
      ELSE IF(STATUS .EQ. -1002) THEN
        CALL ZMESS('[ISTCR Warnings Notified].',1)
      ELSE
        CALL ZMESS('[ISTCR Errors Notified].',1)
      ENDIF
      CALL ZQUIT(STATUS)
 
      END
C-----------------------------------------------------------
C
C  READ THE COMMAND FILE. THE FILE CONTAINS COMMENT, COMMAND AND
C  CHANGE REQUEST LINES, THE FIRST 2 TYPE ARE EASY, THE CHANGE
C  REQUESTS ARE MUCH HARDER....
C
      INTEGER FUNCTION READCF(FD)
 
      INTEGER FD, STATUS, I, START, END
      INTEGER BUFFER(134), PROMPT(10)
      INTEGER ZGTCMD, ZLOWER, ZSPLIT, INDEXX, LENGTH
 
      INTEGER PATSTR(134, 1000), REPSTR(134,1000),
     +        PUPAT(134,1000),MASKS(2, 1000), NAMTYP(1000)
      INTEGER LIMIT
      LOGICAL SELECT(1000), CASFOL, LIST, QUERY, WARN
      COMMON /PATS/ PATSTR, REPSTR, LIMIT, PUPAT, SELECT, MASKS,
     +              NAMTYP, CASFOL, LIST, QUERY, WARN
 
      SAVE /PATS/
 
      DATA PROMPT/67,111,109,109,97,110,100,58,32,129/
 
      CASFOL = .FALSE.
      QUERY  = .FALSE.
      LIST   = .TRUE.
      WARN   = .TRUE.
      READCF = -1
      LIMIT  = 0
C
C  LOOP POINT. KEEP READING IN LINES (PROMPTING IF NECESSARY) TILL THE
C              END OF THE COMMAND FILE........
C
   10 CONTINUE
        IF(FD .EQ. 0) CALL ZPRMPT(PROMPT)
        STATUS = ZGTCMD(BUFFER, FD)
 
        IF(STATUS .EQ. -100) THEN
          IF(LIMIT .GT. 0) READCF = -2
 
        ELSE IF(STATUS .NE. -1) THEN
 
          IF(BUFFER(1) .EQ. 37) THEN
C           THIS IS A COMMAND LINE.......................
            IF(ZLOWER(BUFFER(2)) .EQ. 102) CASFOL = .TRUE.
            IF(ZLOWER(BUFFER(2)) .EQ. 108) LIST   = .FALSE.
            IF(ZLOWER(BUFFER(2)) .EQ. 113) QUERY  = .TRUE.
            IF(ZLOWER(BUFFER(2)) .EQ. 119) WARN   = .FALSE.
            GO TO 10
 
          ELSE IF(BUFFER(1) .NE. 35 .AND. STATUS .GT. 1) THEN
C           THIS IS A CHANGE REQUEST LINE.......................
            LIMIT = LIMIT + 1
            IF(LIMIT .GT. 1000) CALL ERROR('[ISTCR: Too many changes].')
            START = 1
            CALL SKIPBL(BUFFER, START)
C
C  SEPARATE OUT THE PROGRAM UNIT SELECTOR
C
            IF(BUFFER(START) .EQ. 47) THEN
              CALL SCOPY(BUFFER, START, PUPAT(1, LIMIT), 1)
              PUPAT(1, LIMIT) = 37
              START = INDEXX(PUPAT(1, LIMIT), 47)
              IF(START .EQ. 0) THEN
                CALL ERROR('[ISTCR: Invalid PU selector].')
              ELSE
                SELECT(LIMIT) = .TRUE.
                PUPAT(START, LIMIT) = 36
                PUPAT(START+1, LIMIT) = 129
                START = START + 1
                CALL SKIPBL(BUFFER, START)
              ENDIF
            ELSE
              SELECT(LIMIT) = .FALSE.
            ENDIF
C
C  NOW FIND THE END OF THE QUALIFIERS AND GET THE
C  PATTERN MATCH/REPLACEMENT ACTUALLY REQUIRED.
C
            DO 30 END = STATUS, 1, -1
              IF(BUFFER(END) .EQ. 41) THEN
                I = END + 1
                IF(ZSPLIT(BUFFER(I),PATSTR(2,LIMIT),REPSTR(1,LIMIT))
     +             .NE. -1) THEN
                  PATSTR(1, LIMIT) = 37
                  I = LENGTH(PATSTR(1, LIMIT))
                  PATSTR(I+1, LIMIT) = 36
                  PATSTR(I+2, LIMIT) = 129
                ELSE
                  CALL ERROR('[ISTCR: Pattern Split Error].')
                ENDIF
                BUFFER(END+1) = 129
                GO TO 20
              ENDIF
   30       CONTINUE
            CALL ERROR('[ISTCR: No Pattern Specified].')
C
C  NOW FIND OUT ABOUT THE QUALIFIERS
C
   20       CONTINUE
            BUFFER(END + 1) = 129
            CALL ZTOLOW(BUFFER(START))
            CALL GETVAL(BUFFER(START))
          ENDIF
 
          GO TO 10
        ENDIF
 
      END
C ----------------------------------------------------------------------
C
C  ROUTINE TO IDENTIFY THE SYMBOL QUALIFIERS
C
      SUBROUTINE GETVAL(BUFFER)
 
      INTEGER C1, C2, C3, ZIOR, GETW, LENT, INDEXX, I, J,
     + VALUE
      INTEGER BUFFER(*), START, END, POINT, NAME(134),
     +  WORD(134), TYPES(10)
      INTEGER PATSTR(134, 1000), REPSTR(134,1000),
     +        PUPAT(134,1000),MASKS(2, 1000), NAMTYP(1000)
      INTEGER LIMIT
      LOGICAL SELECT(1000), CASFOL, LIST, QUERY, WARN
      COMMON /PATS/ PATSTR, REPSTR, LIMIT, PUPAT, SELECT, MASKS,
     +              NAMTYP, CASFOL, LIST, QUERY, WARN
 
      SAVE /PATS/, TYPES
 
      DATA TYPES/98,112,105,114,108,120,100,99,103,129/
C
C  FIRSTLY GET THE SYMBOL TYPE, IGNORING ANY LEADING 'S_' THAT
C  MAY BE PRESENT.......
C
      START = 1
      IF(BUFFER(1) .EQ. 115 .AND.
     +   BUFFER(2) .EQ. 95) START = START + 2
      C1 = BUFFER(START)
      C2 = BUFFER(START+1)
 
      IF(C1 .EQ. 99) THEN
        NAMTYP(LIMIT) = 1
      ELSE IF(C1 .EQ. 110) THEN
        NAMTYP(LIMIT) = 2
      ELSE IF(C1 .EQ. 112  .AND. C2 .EQ. 117) THEN
        NAMTYP(LIMIT) = 3
      ELSE IF(C1 .EQ. 118) THEN
        NAMTYP(LIMIT) = 4
      ELSE IF(C1 .EQ. 112  .AND. C2 .EQ. 97) THEN
        NAMTYP(LIMIT) = 5
      ELSE IF(C1 .EQ. 112  .AND. C2 .EQ. 114) THEN
        NAMTYP(LIMIT) = 6
      ELSE IF(C1 .EQ. 115) THEN
        NAMTYP(LIMIT) = 7
      ELSE IF(C1 .EQ. 101) THEN
        NAMTYP(LIMIT) = 8
      ELSE
        CALL ERROR('[ISTCR: Unknown Symbol Type].')
      ENDIF
 
 
      IF(NAMTYP(LIMIT) .EQ. 1) THEN
C       COMMON BLOCKS, NO FURTHER QUALIFICATION RELEVANT..........
 
      ELSE
C       GET DATA TYPES, IF ANY.......................
        I = INDEXX(BUFFER, 58)
        IF(I .EQ. 0) THEN
          MASKS(1, LIMIT) = 1023
 
        ELSE
          MASKS(1, LIMIT) = 0
100       CONTINUE
            I = I + 1
            J = INDEXX(TYPES, BUFFER(I))
            IF(J .NE. 0) THEN
              VALUE = 2**(J-1)
              MASKS(1, LIMIT) = ZIOR(MASKS(1, LIMIT), VALUE)
              GO TO 100
            ENDIF
        ENDIF
 
C       FIND THE QUALIFIERS............................
        START = INDEXX(BUFFER, 40) + 1
        MASKS(2, LIMIT) = 0
 
20      CONTINUE
        LENT = GETW(BUFFER, START, WORD)
        IF(LENT .NE. 0) THEN
          C1 = WORD(1)
          C2 = WORD(2)
          C3 = WORD(3)
          IF(C1 .EQ. 97 .AND. C2 .EQ. 114) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 2048)
          ELSE IF(C1 .EQ. 97  .AND. C2 .EQ. 115) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 16)
          ELSE IF(C1 .EQ. 99  .AND. C2 .EQ. 111) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 1024)
          ELSE IF(C1 .EQ. 100  .AND. C2 .EQ. 97) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 128)
          ELSE IF(C1 .EQ. 100  .AND. C2 .EQ. 117) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 4)
          ELSE IF(C1 .EQ. 101  .AND. C2 .EQ. 113) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 512)
          ELSE IF(C1.EQ.101.AND.C2.EQ.120.AND.C3.EQ.112) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 16384)
          ELSE IF(C1.EQ.101.AND.C2.EQ.120.AND.C3.EQ.116) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 1)
          ELSE IF(C1 .EQ. 102)THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 8192)
          ELSE IF(C1.EQ.105.AND.C2.EQ.110.AND.C3.EQ.100) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 65536)
          ELSE IF(C1.EQ.105.AND.C2.EQ.110.AND.C3.EQ.116) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 2)
          ELSE IF(C1 .EQ. 114) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 64)
          ELSE IF(C1 .EQ. 115  .AND. C2 .EQ. 101) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 32)
          ELSE IF(C1 .EQ. 115  .AND. C2 .EQ. 102) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 256)
          ELSE IF(C1 .EQ. 115  .AND. C2 .EQ. 116) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 4096)
          ELSE IF(C1 .EQ. 115  .AND. C2 .EQ. 117) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 32768)
          ELSE IF(C1 .EQ. 117) THEN
            MASKS(2, LIMIT) = ZIOR(MASKS(2, LIMIT), 125936)
          ELSE
          ENDIF
 
          GO TO 20
        ENDIF
      ENDIF
 
      END
C ----------------------------------------------------------------------
C
C  GET THE NEXT WORD. A WORD IS DEFINED AS BEING AN UNBROKEN STRING
C  OR ALPHABETIC CHARACTERS. THE POINTER 'START' IS RETURNED POINTING
C  TO THE FIRST CHARACTER OF THE NEXT WORD.
C
      INTEGER FUNCTION GETW(BUFFER, START, WORD)
 
      INTEGER START, TYPE
      INTEGER WORD(*), BUFFER(*)
 
      GETW = 0
      CALL SKIPBL(BUFFER, START)
   10 CONTINUE
        IF(TYPE(BUFFER(START)) .EQ. 1) THEN
          GETW = GETW + 1
          WORD(GETW) = BUFFER(START)
        ELSE
          WORD(GETW+1) = 129
   20     CONTINUE
            START = START + 1
            IF(BUFFER(START) .EQ. 129) RETURN
          IF(TYPE(BUFFER(START)) .NE. 1) GO TO 20
          RETURN
        ENDIF
        START = START + 1
      GO TO 10
 
      END
C ----------------------------------------------------------------------
C
C  PROFIL   -   Process the file
C               GO THROUGH, CHECKING TO SEE IF ANY OF THE SYMBOLS
C               MATCH THE CHANGE COMMANDS AND THEN TRYING TO CHANGE
C               THEM.
C
 
      SUBROUTINE PROFIL(FD, STATE)
 
      INTEGER SYMPTR, BITS, NSYMS, I, TEST, PU, STATUS, JUNK1, JUNK2,
     +        FD, STRPTR, TEST1, STATE
      INTEGER SYMBOL(8), BUFFER(134), EXTNAM(134),
     +        SYMIDX(1000), PUNAME(134), PROMPT(20), RESULT(8)
      INTEGER ZYGNSY, ZIAND, ZYASTR, ZYFSYM, ZPREPL, ZPFIND, ZSETR,
     +        ZSETP, ZGTCMD, EQUAL, ZYESNO
 
      LOGICAL MATCH, LEGAL, TEST2
 
      INTEGER PATSTR(134, 1000), REPSTR(134,1000),
     +        PUPAT(134,1000),MASKS(2, 1000), NAMTYP(1000),
     +        LIMIT
      LOGICAL SELECT(1000), CASFOL, LIST, QUERY, WARN
      COMMON /PATS/ PATSTR, REPSTR, LIMIT, PUPAT, SELECT, MASKS,
     +              NAMTYP, CASFOL, LIST, QUERY, WARN
 
      SAVE /PATS/
 
      DATA PROMPT/32,32,32,69,110,116,101,114,32,110,
     +            101,119,32,110,97,109,101,58,32,129/
 
      PU = 1
      STATE = -2
C
C  LOOP POINT. COME BACK TO HERE TO START PROCESSING EACH PROGRAM UNIT,
C              ALL IS OVER WHEN A PROGRAM UNIT HAS NO SYMBOLS.
C
   10 CONTINUE
 
        CALL ZYGSSI(SYMIDX, NSYMS, PU)
        IF (NSYMS .EQ. 0) RETURN
 
        DO 20 I =1, NSYMS
          CALL ZYGTSY(SYMIDX(I), SYMBOL)
          IF(SYMBOL(1) .EQ. 4) THEN
            CALL ZYGTST(SYMBOL(2), PUNAME)
            IF(LIST) THEN
              CALL ZCHOUT('In program unit: .', 1)
              CALL ZPTMES(PUNAME, 1)
            ENDIF
            GO TO 15
          ENDIF
   20   CONTINUE
 
   15 CONTINUE
 
        DO 40 TEST = 1, LIMIT
C
C  IS THERE A PROGRAM UNIT SELECTION TO BE MADE?
C
          IF(SELECT(TEST)) THEN
            STATUS = ZSETP(PUPAT(1, TEST), CASFOL)
            IF(ZPFIND(PUNAME,1,JUNK1, JUNK2) .EQ. -3) GO TO 40
          ENDIF
 
          DO 30 I = 1, NSYMS
            CALL ZYGTSY(SYMIDX(I), SYMBOL)
C
C  FIRST CHECK SYMBOL SELECTION
C
            MATCH = .FALSE.
            IF(SYMBOL(1) .EQ. 2) THEN
              IF(NAMTYP(TEST) .EQ. 1) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 3) THEN
              IF(NAMTYP(TEST) .EQ. 2) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 4) THEN
              IF(NAMTYP(TEST) .EQ. 3) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 5) THEN
              IF(NAMTYP(TEST) .EQ. 4) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 6) THEN
              IF(NAMTYP(TEST) .EQ. 5) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 7) THEN
              IF(NAMTYP(TEST) .EQ. 6) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 8) THEN
              IF(NAMTYP(TEST) .EQ. 7) MATCH = .TRUE.
            ELSE IF(SYMBOL(1) .EQ. 9) THEN
              IF(NAMTYP(TEST) .EQ. 8) MATCH = .TRUE.
            ENDIF
C
C  NOW CHECK DATA TYPE
C
            IF(MATCH) THEN
              MATCH = .FALSE.
              IF(SYMBOL(4) .EQ. -2) BITS = 1
              IF(SYMBOL(4) .EQ. -1) BITS = 2
              IF(SYMBOL(4) .EQ. 1) BITS = 4
              IF(SYMBOL(4) .EQ. 2) BITS = 8
              IF(SYMBOL(4) .EQ. 3) BITS = 16
              IF(SYMBOL(4) .EQ. 4) BITS = 32
              IF(SYMBOL(4) .EQ. 5) BITS = 64
              IF(SYMBOL(4) .EQ. 6) BITS = 128
              IF(SYMBOL(4) .EQ. 8) BITS = 256
              IF(ZIAND(BITS, MASKS(1, TEST)) .NE. 0) MATCH = .TRUE.
            ENDIF
C
C  NOW CHECK ATTRIBUTE BITS
C
            IF(MATCH .AND.
     +         ((ZIAND(SYMBOL(6), MASKS(2, TEST)) .NE. 0)
     +         .OR. (MASKS(2, TEST) .EQ. 0)))THEN
              CALL ZYGTST(SYMBOL(2), EXTNAM)
              STATUS = ZSETP(PATSTR(1, TEST), CASFOL)
              STATUS = ZSETR(REPSTR(1, TEST))
              IF(STATUS .EQ. -1) RETURN
              STATUS = ZPREPL(EXTNAM, BUFFER, .FALSE.)
 
              IF(STATUS .EQ. -2) THEN
   13           CONTINUE
                TEST1 = ZYFSYM(BUFFER, PU, RESULT)
                TEST2 = LEGAL(BUFFER, STATE)
                IF(TEST1 .EQ. -1 .AND. TEST2) THEN
                  IF(QUERY) THEN
                    IF(.NOT. LIST) THEN
                      CALL ZCHOUT('In program unit: .', 1)
                      CALL PUTLIN(PUNAME, 1)
                    ENDIF
                    CALL ZCHOUT(' About to change .', 1)
                    CALL PUTLIN(EXTNAM, 1)
                    CALL ZCHOUT(' to .', 1)
                    CALL ZPTMES(BUFFER, 1)
                    IF(ZYESNO(-3) .EQ. -3) GO TO 30
                  ENDIF
                  STRPTR = ZYASTR(BUFFER)
                  CALL ZYSATT(SYMIDX(I), 2, STRPTR)
                  IF(LIST) THEN
                    CALL ZCHOUT('    .', 1)
                    CALL PUTLIN(EXTNAM, 1)
                    CALL ZCHOUT(' changed to .', 1)
                    CALL ZPTMES(BUFFER, 1)
                  ENDIF
                ELSE IF(EQUAL(BUFFER, EXTNAM) .EQ. -2) THEN
C                 NAMES ARE IDENTICAL
                ELSE
                  IF(FD .NE. 0) THEN
                    CALL ZCHOUT('In program unit: .', 2)
                    CALL PUTLIN(PUNAME, 2)
                    CALL ZCHOUT(' - Unable to change .', 2)
                    CALL PUTLIN(EXTNAM, 2)
                    CALL ZCHOUT(' to .', 2)
                    CALL ZPTMES(BUFFER, 2)
                    CALL ERROR('[ISTCR: Error Termination].')
                  ELSE
                    IF(.NOT. LIST) THEN
                      CALL ZCHOUT('In program unit: .', 1)
                      CALL PUTLIN(PUNAME, 1)
                    ENDIF
                    IF(TEST1 .NE. -1) THEN
                      CALL ZCHOUT(' - Name clash changing .', 1)
                    ELSE
                      CALL ZCHOUT(' - Unable to change .', 1)
                    ENDIF
                    CALL PUTLIN(EXTNAM, 1)
                    CALL ZCHOUT(' to .', 1)
                    CALL ZPTMES(BUFFER, 1)
                    CALL ZPRMPT(PROMPT)
                    STATUS = ZGTCMD(BUFFER, FD)
                    IF(STATUS .EQ. -100 .OR. STATUS .EQ. -1) CALL
     +                  ERROR('[ISTCR: Error Termination].')
                    GO TO 13
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
   30     CONTINUE
 
   40   CONTINUE
 
        PU = PU + 1
 
      GO TO 10
 
      END
C----------------------------------------------------------
C
C  CHECK THE LEGALITY OF A SYMBOL NAME. AT THE MOMENT A LEGAL
C  SYMBOL NAME IS ANYTHING WITH 1 TO 6 CHARACTERS EACH OF WHICH
C  IS AN UPPERCASE LETTER OR A DIGIT AND THE FIRST OF WHICH IS A
C  LETTER.
C
C  THIS CONCEPT OF LEGALITY CAN BE CUSTOMISED TO LOCAL REQUIREMENTS
C  (E.G. ARBITRARY LENGTH, ANY CASE AND INCLUDING UNDERLINES).
C
      LOGICAL FUNCTION LEGAL(NAME, STATE)
 
      INTEGER NAME(*), STATE
      LOGICAL TEST1, TEST2
 
      INTEGER PATSTR(134, 1000), REPSTR(134,1000),
     +        PUPAT(134,1000),MASKS(2, 1000), NAMTYP(1000),
     +        LIMIT
      LOGICAL SELECT(1000), CASFOL, LIST, QUERY, WARN
      COMMON /PATS/ PATSTR, REPSTR, LIMIT, PUPAT, SELECT, MASKS,
     +              NAMTYP, CASFOL, LIST, QUERY, WARN
 
      SAVE /PATS/
 
      LEGAL = .TRUE.
 
      CALL ZLEGAL(NAME, TEST1, TEST2)
      IF(.NOT. TEST1) THEN
        IF(TEST2)THEN
          IF(WARN) THEN
            IF(STATE .EQ. -2) STATE = -1002
            CALL ZCHOUT('CR: Warning, name is non-standard: .', 1)
            CALL ZPTMES(NAME, 1)
          ENDIF
        ELSE
          CALL ZCHOUT('CR: Error, name is illegal: .', 1)
          CALL ZPTMES(NAME, 1)
          STATE = -1
          LEGAL = .FALSE.
        ENDIF
      ENDIF
 
      END
